COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	DEFINE NIL='400000, LIST="INTEGER"
C00006 ENDMK
C⊗;
DEFINE NIL='400000, LIST="INTEGER";
OWN LIST ARRAY CAD,EVC[NIL:NIL+NLIST], ROOT[0:NROOT];
FORWARD RECURSIVE STRING PROCEDURE CVLIST(LIST LST);

LIST PROCEDURE CAR(LIST EL); RETURN(CAD[EL] LSH -18);

LIST PROCEDURE CDR(LIST EL); RETURN(CAD[EL] LAND '777777);

BOOLEAN PROCEDURE NULLP(LIST EL); RETURN(EL=NIL);

BOOLEAN PROCEDURE LISTP(LIST EL); RETURN(EL>NIL);

BOOLEAN PROCEDURE ATOMP(LIST EL); RETURN(EL<NIL);

RECURSIVE PROCEDURE COLLECT(LIST NODE);
IF LISTP(NODE) THEN
   BEGIN
   EVC[NODE]←EVC[NODE]-1;
   IF (EVC[NODE] LAND '777777)=0 THEN
      BEGIN
      COLLECT(CAR(NODE));
      COLLECT(CDR(NODE));
      CAD[NODE]←ROOT[0];
      EVC[NODE]←1;
      ROOT[0]←NODE;
      END;
   END;

LIST PROCEDURE CONS(LIST A,B);
   BEGIN
   LIST NODE;
   IF LISTP(A) THEN EVC[A]←EVC[A]+1;
   IF LISTP(B) THEN EVC[B]←EVC[B]+1;
   IF NULLP(ROOT[0]) THEN
      BEGIN
      FOR NODE←NIL+1 STEP 1 UNTIL NIL+NLIST DO
      IF (EVC[NODE] LAND '777777)=0 THEN
	 BEGIN
	 COLLECT(CAR(NODE));
	 COLLECT(CDR(NODE));
	 CAD[NODE]←ROOT[0];
	 EVC[NODE]←1;
	 ROOT[0]←NODE;
	 END;
      END;
   IF NULLP(ROOT[0]) THEN
      BEGIN
      OUTSTR("List storage capacity exceeded"&'15&'12);
      call(0,"EXIT");
      END;
   NODE←ROOT[0];
   ROOT[0]←CDR(ROOT[0]);
   CAD[NODE]←(A LSH 18) LOR B;
   EVC[NODE]←NODE LSH 18;
   RETURN(NODE);
   END;

PROCEDURE SETQ(REFERENCE INTEGER RT; LIST LS);
   BEGIN
   IF LISTP(LS) THEN EVC[LS]←EVC[LS]+1;
   COLLECT(RT); RT←LS;
   END;

PROCEDURE LINIT;
   BEGIN
   LIST I;
   CAD[NIL]←NIL; EVC[NIL]←0; ROOT[0]←NIL+1;
   FOR I←NIL+1 STEP 1 UNTIL NIL+NLIST DO
      BEGIN
      CAD[I]←I+1;
      EVC[I]←I LSH 18;
      END;
   CAD[NIL+NLIST]←NIL;
   FOR I←1 STEP 1 UNTIL NROOT DO ROOT[I]←NIL;
   END;

RECURSIVE STRING PROCEDURE CVLIST(LIST LST);
   BEGIN
   RECURSIVE STRING PROCEDURE LSTLST(LIST LST);
   RETURN(
      IF NULLP(LST) THEN "" ELSE
      IF ATOMP(LST) THEN "."&CVS(LST) ELSE
      " "&CVLIST(CAR(LST))&LSTLST(CDR(LST))
   );
   RETURN(
      IF NULLP(LST) THEN "()" ELSE
      IF ATOMP(LST) THEN CVS(LST) ELSE
      "("&CVLIST(CAR(LST))&LSTLST(CDR(LST))&")"
   );
   END;

RECURSIVE INTEGER PROCEDURE LENGTHI(LIST LS);
   RETURN(IF LISTP(LS) THEN 1+LENGTHI(CDR(LS)) ELSE 0);